#!/usr/bin/perl -w
# 
# PAN API
#
# Created by Martin Walter on 10/4/10.
# Copyright 2010 Palo Alto Networks. All rights reserved.

=pod

=head1 NAME

PAN/API.pm Created by Martin Walter on 10/4/10

=head1 SYNOPSIS

use PAN::API;

=head1 DESCRIPTION

This module provides an interface to Palo Alto Networks APIs.

Copyright 2010 Palo Alto Networks. All rights reserved.

=head1 Dependencies

=over 5

=item XML::Simple

=item Net::Domain

=item IO::Socket::INET

=item IO::Socket::SSL

=back

=cut

package	PAN::API::UID;

use strict;
use warnings;
use base 'Exporter';
use Carp;
use IO::Socket::SSL;
use XML::Simple;
our $VERSION	= 0.2.1;
our $DEBUG	= 0;

=pod

=head1 User-ID Agent API

=head2 Object initialisation

=over 5

=item new()

Initializes a new PAN::API::UID object. The only parameter it takes is the IP address or hostname of the machine running the User-ID Agent XML API.

 use PAN::API;
 my $class=PAN::API::UID->new($ipaddress,$tcpport);

=back

=cut

sub new ($)	 	{
	my	$self			= shift;
	my	%params;

		$params{server}	= shift || '127.0.0.1';
		$params{port}	= shift || '5006';
		$params{version}= '1.0';
		$params{type}	= 'update';
		$params{events}	= {};

	my	$class			= bless { %params };
	
	return $class;
}

=pod

=head2 Functions

=over 5

=item login()

Initiates a simple login message to the User-ID Agent XML API. It takes two parameters, the first being the user name and the second being the IP address. 

 $class->login($username,$ipaddress);

User names can be in any form, though for proper user IP mapping, the usual NetBios syntax is preferred. In case no username is provided, the C<login> function tries retrieve a valid username from the environment. IP address is provided in dot-decimal notation. If no IP address is provided, the login function tries to identify a valid IP address from the operating system.

=back

=cut

sub login ($$)	{
	my	$self			= shift;
	my	$name			= shift || myusername();
	my	$ip				= shift || myhostaddr();

	$self->add("login",$name,$ip);
	$self->submit;
}

=pod

=item logout()

Equivalent to login(). Takes the same variables and makes the same assumptions if values are not omitted.

 $class->logout($username,$ipaddress);

=cut

sub logout ($$)	{
	my	$self				= shift;
	my	$name				= shift || myusername();
	my	$ip					= shift || myhostaddr();

	$self->add("logout",$name,$ip);
	$self->submit;
}

=pod 

=item add()

Adds an login/logout event to the object cache for bulk submission of events to the User-ID Agent XML API.

 $class->add($eventtype,$username,$ipaddress);

For example, sending a collection of logon or logout events would be done like this:

 use PAN::API;
 $uid=PAN::API::UID->new('10.0.0.1');
 $uid->add('logon','pan\mwalter','10.0.1.100');
 $uid->add('logout','pan\mwalter','10.0.1.101');
 $uid->submit();

... where C<submit> essentially sends all cached events to the User-ID Agent XML API configured with C<new>

=cut

sub add ($$$)	{
	my	$self				= shift;
	my	$type				= shift;
	my	$name				= shift;
	my	$ip					= shift;
	
		push @ {$self->{events}{$type} },{name=>$name,ip=> $ip};
}

=pod 

=item submit()

Submits cached events to the configured User-ID Agent XML API.

 $class->submit();

=cut

sub submit () {
	my	$self				= shift;
	my	$socketssl			= opensocket($self->{server},$self->{port});
	print	$socketssl $self->xmlout;
		closesocket($socketssl);
}

=pod 

=item xml()

Prints all cached events as the corresponding XML block.

 $class->xmlout();

For example, C<print $uid->xmlout();> would print this

 <uid-message>
  <payload>
    <login>
      <entry name="mwalter" ip="10.0.1.100" />
    </login>
    <logout>
      <entry name="mwalter" ip="10.0.1.101" />
    </logout>
  </payload>
  <type>update</type>
  <version>1.0</version>
</uid-message>

=cut

sub xmlout () {
	my	$self				= shift;
	
	my	$xmls = XML::Simple->new(RootName=>'uid-message');
	
	my	(%payload,%message);
	
		$message{version}[0]= $self->{version};
		$message{type}[0]	= $self->{type};
		$message{payload}	= $self->{events};
		
	return $xmls->XMLout(\%message,GroupTags=>{login => 'entry',logout=>'entry'});
}

=pod

=back

=cut

sub myusername () {
	if		(lc($^O) eq "mswin32") {
		return $ENV{USERDOMAIN}."\\".$ENV{USERNAME};	
	}
	else	{
		use Net::Domain qw(hostdomain);
		return $ENV{USER}."@".lc(hostdomain) if hostdomain ne "";
		return $ENV{USER};
	}						
}

# Had to change type "unsigned char value" in unpack('W4') to ('C4') because of compatibility issues with Perl 5.8
sub myhostaddr () {
	use Net::Domain qw(hostname);
	return join ".",(unpack('C4',gethostbyname(hostname)));
}

sub hostcert () {
	
}

sub debug () {
	$DEBUG = 1;
}

sub opensocket($$) {
	my	$server		= shift;
	my	$port		= shift;
	
	my	$socket		= IO::Socket::SSL->new(
			PeerHost	=>$server,
			PeerPort	=>$port)
		|| _error("Unable to connect socket. ",IO::Socket::SSL::errstr());
	#$self->{'ssl'}	= $socket if $self;
	return $socket;
}

sub closesocket () {
	my	$socket				= shift;
		$socket->close(SSL_fast_shutdown =>1 );
	}

sub error () {
	
}

sub _error ($) {
	croak $_[0].$_[1] if $DEBUG;
	croak $_[0] if !$DEBUG;
} 

1;

=pod

=head2 Examples

The following section explains two very simple examples on how you could use this module in your own scripts.


=head3 Logon script

A simple logon script written in Perl would look like the following on a Windows platform:

 #!/usr/bin/perl -w
 
 use strict;
 use PAN::API;
 
 my	$useridagent	= '10.0.0.99';
 
 my	$useridapi	= PAN::API::UID->new($useridagent);
 
 my	$user		= $ENV{USERDOMAIN}.'/'.$ENV{USERNAME};
 my	$ipaddress	= unpack('W4',gethostbyname($ENV{COMPUTERNAME}));
 
	$useridapi->login($user,$ipaddress);

=head3 Logout script

Or the same for a logout script, but maybe a little simpler.

 use strict;
 use PAN::API;
 
 my	$useridagent	= '10.0.0.99';
 
 my	$useridapi	= PAN::API::UID->new($useridagent);
	$useridapi->logout();

=cut
